perm filename PT2D.KLF[MSS,LCS] blob
sn#244646 filedate 1976-10-28 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE PT2
C00010 ENDMK
Cā;
SUBROUTINE PT2
INTEGER VALID
DIMENSION VALID(6),BARS(1),JBAR(1),JRN(1),MBAR(1)
DATA QLINE/140.0/,HX/2./,VALID/1,4,8,2,3,-2/,SLSP/11.0/,DIV/4./
C QLINE=BASIC LINE LENGTH, HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.
C ADD MORE TO VALID LATER *****
COMMON /FIN/LBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK,
1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4) /KBAR/KBAR(512)
1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T
COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
COMMON/STF/RSTFAC(-3/4),RSTJ2 /IVV/IV(1) /SIZE/SIZE
COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(36)
EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(KT,KBAR)
1,(R8,RQ(6)),(R9,RQ(7)),(JRN,RN),(MBAR,RN(1000))
1,(LCNT,IV(45)),(NDPY,IV(46)),(TOT,KBAR(2)),(JBAR,BARS,KBAR(4))
C TRNSP'S Bb, F, BBb, A, G, Eb.
145 FORMAT(F,2I)
CCC IF(RS.NE.'OLD')GO TO 2000
CALL GETFIL('BARS')
CALL FASTIN(KBAR,512)
CALL FASTIN(RSTFAC,128)
2000 TYPE 144,RSTJ2
CC144 FORMAT(' STAFF SIZE, TRANSP. '$)
144 FORMAT(' STAFF SIZE='F4.2,' CHANGE TO '$)
ACCEPT 145,SIZE,LL
IF(SIZE.NE.0)GO TO 101
SIZE=1
CC GO TO 33
101 DO 22 K=1,KT
22 JBAR(K)=BARS(K)*SIZE+.5
TOT=TOT*SIZE
33 IF(RSTJ2.EQ.0)RSTJ2=1
RA=JPG*SIZE*RSTJ2
MPG=10./RA
C MPG=NUM OF BRACES PER PAGE.
SPG=10./MPG
C SPG IS SPACE TO BE SET ABOVE STAFF 0
RA=(RSTJ2*SIZE)/RPSZ(1)
DO 141 K=1,JPG
141 RPSZ(K)=RPSZ(K)*RA
LPG=JPG
IF(MOD(LL,7).EQ.0)GO TO 140
DO 40 L=1,6
40 IF(LL.EQ.VALID(L))GO TO 140
TYPE 240
GO TO 2000
240 FORMAT(' THIS TRANSP NOT OFFERED')
140 TYPE 90,KT
RA=0
90 FORMAT(' TOTAL BAR LINES='I3/' NUMBER OF BARS PER LINE')
JT=TOT/QLINE
C USE QLINE (140 FOR NOW) AS SUGGESTED LINE LENGTH
16 MAX=0
MIN=10000
NT=JT
L=0
KLEF=0
JTOT=TOT+.5
JTOT=JTOT+6*(JT-1)
KAV=JTOT/JT
LMAX=10000
NBAR(1)=1
J=1
3 M=1
JAV=JTOT/NT
C ADD SPACE FOR CLEFS (6) AFTER 1ST LINE
IF(JAV.GT.KAV)JAV=JAV-2
IF(JAV.LT.KAV)JAV=JAV+2
K=JBAR(J)
1 J=J+1
IF(J.GT.KT)GO TO 2
N=JBAR(J)
IF(K+N/2.GE.JAV)GO TO 2
M=M+1
K=K+N
GO TO 1
2 L=L+1
K=K+KLEF
JTOT=JTOT-K
NT=NT-1
JRN(L)=K
KLEF=6
C AFTER 1ST LINE, ADD SOME SPACE FOR CLEFS.
NBAR(L+1)=J
IF(NT.NE.0)GO TO 3
5 MAX=0
MIN=10000
DO 7 L=1,JT
K=JRN(L)
IF(K.LE.MAX)GO TO 6
MAX=K
MX=L
6 IF(K.GE.MIN)GO TO 7
MIN=K
MN=L
7 CONTINUE
IF(MAX.GE.LMAX)GO TO 9
LMAX=MAX
DO 8 J=1,JT+1
C SAVE NBAR INFO IN MBAR
8 MBAR(J)=NBAR(J)
IF(MX.LT.MN)GO TO 32
JJ=0
JM=-1
JK=1
23 K=NBAR(MX+JJ)-JJ
C NEXT RIPPLES THE BARS, FROM MAX TO MIN.
MM=JBAR(K)
JRN(MX)=JRN(MX)-MM
JRN(MX+JM)=JRN(MX+JM)+MM
NBAR(MX+JJ)=K+JK
MX=MX+JM
IF(JJ.NE.0)GO TO 223
IF(MX.GT.MN)GO TO 23
GO TO 5
223 IF(MX.LT.MN)GO TO 23
GO TO 5
32 JJ=1
JM=1
JK=0
GO TO 23
9 MBAR(JT+1)=KT+1
KLEF=0
DO 10 K=1,JT
N=MBAR(K)
M=MBAR(K+1)
NBAR(K)=N
JJ=0
DO 15 J=N,M-1
15 JJ=JJ+JBAR(J)
JRN(K)=JJ+KLEF
10 KLEF=6
13 DO 14 L=2,JT
K=NBAR(L)
MM=JRN(L)
KK=JRN(L-1)
IF(MM.GE.KK)GO TO 12
C JUGGLES ADJACENT LINES
N=JBAR(K-1)
IF(KK-MM.LT.N)GO TO 14
JRN(L-1)=KK-N
JRN(L)=MM+N
NBAR(L)=K-1
GO TO 13
12 N=JBAR(K)
IF(MM-KK.LE.N)GO TO 14
JRN(L-1)=KK+N
JRN(L)=MM-N
NBAR(L)=K+1
GO TO 13
14 CONTINUE
46 J=1
NBAR(JT+1)=KT+1
JTOT=TOT+.5
JTOT=JTOT+6*(JT-1)
C ADD SPACE FOR CLEFS (6) AFTER 1ST LINE
JAV=JTOT/JT
TYPE 306,JAV
GO TO 307
PRINT 306,JAV
307 DO 305 K=1,JT
NBAR(K)=NBAR(K+1)-NBAR(K)
C NBAR NOW HAS NUM. OF BARS PER LINE.
L=NBAR(K)-1+J
306 FORMAT(I5,3X8I5)
C AFTER FIRST LINE 6 IS ADDED FOR CLEF SPACE.
TYPE 306,JRN(K),(JBAR(N),N=J,L)
GO TO 305
PRINT 306,JRN(K),(JBAR(N),N=J,L)
305 J=L+1
NBAR(JT+1)=0
RPG=JT
RPG=RPG/MPG
105 TYPE 104,RPG,JT
GO TO 104
PRINT 104,RPG,JT
104 FORMAT(F5.2,' PAGES',/,I4,' LINES - OR TYPE N1, N2 --'$)
C FOR SPECIFICATION OF HOW MANY BARS ON EACH LINE
KA=0
ACCEPT 145,T,N,KL
C TYPE 0,n TO EXIT WITH n SPACING BETWEEN STAVES (2 IS DEFAULT)
IF(KL.NE.0)GO TO 110
C NO MORE THAN 36 NUMS, INCLUDING 0S (FOR PAGE MARKS)
IF(T.EQ.0)GO TO 11
JT=T
IF(N.EQ.0)GO TO 16
C N=0 MEANS T= NUM OF LINES DESIRED.
111 FORMAT(36I)
110 REREAD 111,NBAR
911 DO 112 K=36,1,-1
KP=NBAR(K)
KA=KA+KP
112 IF(KP.EQ.0.AND.KA.EQ.0)KL=K
IF(KA.NE.KT)GO TO 105
C MISMATCH!
N=26-2*MOD(KL-1,12)
IF(N.EQ.26)N=0
C TO SPACE OUT STAVES VERTICALLY
CC IF(IPG)GO TO 11
CC IF(NBAR(1).NE.0)GO TO 11
CC DO 711 K=1,36
CC IF(K.GT.J)IV(K)=0
CC711 NBAR(K)=IV(K)
CC GO TO 911
11 CALL WRTPAG
END